home *** CD-ROM | disk | FTP | other *** search
/ Grapevine 14 / Grapevine 14 (Disk 2 of 3).adf / BOTHPASCAL.S.lha / Grapevine / sources / pascal2 < prev   
Text File  |  1990-09-14  |  4KB  |  149 lines
  1. program test;
  2.  
  3. uses graph, crt;
  4.  
  5. var grdriver, I, grmode, errcode : integer;
  6.     ch : char;
  7.     stopper : boolean;
  8.  
  9. procedure clearbuff;   {CLEARS THE KEYBOARD BUFFER}
  10. var
  11.    void : char;
  12. begin
  13.      while keypressed do
  14.                         void := readkey;
  15. end;
  16.  
  17. procedure title;
  18. begin
  19.      settextstyle (5,0,6);
  20.      setcolor (14);
  21.      outtextxy (50,0,`The Dual Format`);
  22.      outtextxy (265,52,`P.D. Library`);
  23.      setcolor (3);
  24.      line (20,0,600,0);
  25.      line (20,0,20,138);
  26.      line (20,138,600,138);
  27.      line (600,0,600,138);
  28. end;
  29.  
  30. procedure display_menu;
  31. begin
  32.         cleardevice;
  33.         title;
  34.         settextstyle (4,0,5);
  35.         setcolor (10);
  36.         outtextxy (180,140,`Display Menu`);
  37.         line (180,190,420,190);
  38.         line (180,192,420,192);
  39.         settextstyle (8,0,4);
  40.         setcolor (11);
  41.         outtextxy (100,220,`1. Search for Program.`);
  42.         outtextxy (100,260.`2. Search for Disk No.`);
  43.         outtextxy (100,300,`3. Display Options.`);
  44.         outtextxy (100,340,`4. Return to Main Menu.`);
  45.         outtextxy (100,380,`5. Exit Program.`);
  46.         settextstyle (6,0,4);
  47.         setcolor (12);
  48.         outtextxy (180,430,`Press 1 - 5 please`);
  49.         textcolor (12);
  50.  
  51.         repeat
  52.                 if keypressed then
  53.                    begin
  54.                         ch := readkey;
  55.                         stopper := true;
  56.                         restorecrtmode;
  57.  
  58.                         case ch of
  59.                            `1` : writeln (`Thanks for pressing 1`);
  60.                            `2` : writeln (`Thanks for pressing 2`);
  61.                            `3` : writeln (`Thanks for pressing 3`);
  62.                            `4` : writeln (`Thanks for pressing 4`);
  63.                            `5` : writeln (`Thanks for pressing 5`);
  64.                            else writeln (`Not a valid entry`);
  65.                         end;
  66.                    end;
  67.         until stopper;
  68.         delay (1000);
  69. end;
  70.  
  71. procedure title_screen;
  72. begin
  73.         cleardevice;
  74.         settextstyle (4,1,7);
  75.         setcolor (9);
  76.         outtextxy (10,2,`THE`);
  77.         settextstyle (8,0,7);
  78.         setcolor (3);
  79.         outtextxy (90,20,`Dual Format`);
  80.         settextstyle (5,0,7);
  81.         setcolor (2);
  82.         outtextxy (30,120,`PUBLIC DOMAIN`);
  83.         outtextxy (150,180.`LIBRARY`);
  84.         settextstyle (1,0,4);
  85.         setcolor (4);
  86.         outtextxy (40,320,`DISK BASED SOFTWARE CATALOGUE.`);
  87.         settextstyle (1,0,1);
  88.         setcolor (15);
  89.         outtextxy (230,450,` (C) MCMXCIII    DUAL FORMAT ENTERPRISES`);
  90.  
  91.         repeat
  92.         until keypressed;
  93. end;
  94.  
  95. procedure setup;
  96. begin
  97.         stopper := false;
  98.         grdriver := detect;
  99.         initgraph (grdriver, grmode,``);
  100.         errcode := graphresult;
  101.         if errcode <> grok then
  102.                 begin
  103.                         halt;  {error message !!!}
  104.                 end;
  105. end;
  106.  
  107. procedure main_menu;
  108. begin
  109.         setup;
  110.         clearbuff;
  111.         title;
  112.         settextstyle (4,0,5);
  113.         setcolor (10);
  114.         outtextxy (200,140.`Main Menu`);
  115.         line (180,290,420,190);
  116.         line (180,192,420,192);
  117.         settextstyle (8,0,4);
  118.         setcolor (11);
  119.         outtextxy (100,240,`1. Search Database.`);
  120.         outtextxy (100,280,`2. Update Database.`);
  121.         outtextxy (100,320.`3. Exit Package.`);
  122.         settextstyle (6,0,4);
  123.         setcolor (12);
  124.         outtextxy (180,430,`Press 1 - 3 please`);
  125.         textcolor (12);
  126.         repeat
  127.                 if keypressed then
  128.                    begin
  129.                         ch := readkey;
  130.                         stopper := true;
  131.                         restorecrtmode;
  132.                         textcolor (15);
  133.                         case ch of
  134.                            `1` : writeln (`Thanks for pressing 1`);
  135.                            `2` : writeln (`Thanks for pressing 2`);
  136.                            `3` : writeln (`You`ve just quit the program`);
  137.                            else writeln (`Not a valid entry`);
  138.                         end;
  139.                    end;
  140.         until stopper;
  141.         delay (1000);
  142. end;
  143.  
  144. begin
  145.         setup;
  146.         title_screen;
  147.         clearbuff;
  148.         main_menu;
  149. end.